{*******************************************************************************
* The contents of this file are used with permission, subject to the Mozilla   *
* Public License Version 1.1 (the "License"); you may not use this file except *
* in compliance with the License. You may obtain a copy of the License at      *
* http://www.mozilla.org/MPL/                                                  *
*                                                                              *
* Software distributed under the License is distributed on an "AS IS" basis,   *
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for *
* the specific language governing rights and limitations under the License.    *
*                                                                              *
* The Original Code is distributed as part of the "mediate" product and is     *
* Copyright (C) @home media limited. All Rights Reserved.                      *
*                                                                              *
* Email: support@athomemedia.co.uk                                             *
* Web:   http://www.athomemedia.co.uk                                          *
*******************************************************************************}

unit TextEntry;

interface

uses Classes, AHMTypes;

const
  FLASH_INTERVAL = 500; // Flashing interval for cursor in milliseconds

type
  TAHMTextEntryParser = class
  private
    FText: String;
    FCursorPos: Integer;
    FFlashOn: Boolean;
    FFlashTime: TAHMTimestamp;
  protected
    procedure SetText(Text: String);
    function GetDisplayText: String;
    procedure InsertChar(Key: Word);
    procedure Clear;
    procedure Backspace;
    procedure DeleteChar;
    procedure CursorLeft;
    procedure CursorRight;
    procedure CursorUp; virtual;
    procedure CursorDown; virtual;
    procedure CursorHome;
    procedure CursorEnd;
    procedure ScrollUp; virtual;
    procedure ScrollDown; virtual;
    procedure Enter; virtual;
    procedure CommandComplete; virtual;
  public
    property Text: String read FText write SetText;
    property DisplayText: String read GetDisplayText;
    function ProcessKeyPress(Key: Word; Shift: TShiftState): Boolean; overload;
    function ProcessKeyPress(Key: String): Boolean; overload;
  end;

implementation

uses Windows, SysUtils, TagNames, Timing, Canvas;

procedure TAHMTextEntryParser.SetText(Text: String);
begin
  FText := Text;
  FCursorPos := Length(FText);
  FFlashOn := True;
end;

function TAHMTextEntryParser.GetDisplayText: String;
begin
  // Cursor will flash on and off beneath current character
  if TimerInstance.HasDurationElapsed(FFlashTime, FLASH_INTERVAL) then
  begin
    FFlashOn := not FFlashOn;
    FFlashTime := TimerInstance.CurrentTimeStamp;
  end;

  // Include cursor character in entered text
  if FFlashOn then
    Result := Copy(FText, 1, FCursorPos) + Chr(CHAR_CURSOR) +
              Copy(FText, FCursorPos + 1, Length(FText))
  else
    Result := FText;
end;

procedure TAHMTextEntryParser.InsertChar(Key: Word);
begin
  // Insert character in entered text
  FText := Copy(FText, 1, FCursorPos) + Chr(Key) +
           Copy(FText, FCursorPos + 1, Length(FText));
  Inc(FCursorPos);
  FFlashOn := True;
end;

procedure TAHMTextEntryParser.Clear;
begin
  SetText('');
end;

procedure TAHMTextEntryParser.Backspace;
begin
  if FCursorPos > 0 then
  begin
    Delete(FText, FCursorPos, 1);
    Dec(FCursorPos);
    FFlashOn := True;
  end;
end;

procedure TAHMTextEntryParser.DeleteChar;
begin
  Delete(FText, FCursorPos + 1, 1);
  if FCursorPos > Length(FText) then
  begin
    Dec(FCursorPos);
    FFlashOn := True;
  end;
end;

procedure TAHMTextEntryParser.CursorLeft;
begin
  if FCursorPos > 0 then
  begin
    Dec(FCursorPos);
    FFlashOn := True;
  end;
end;

procedure TAHMTextEntryParser.CursorRight;
begin
  if FCursorPos < Length(FText) then
  begin
    Inc(FCursorPos);
    FFlashOn := True;
  end;
end;

procedure TAHMTextEntryParser.CursorUp;
begin
  // Descendant classes will implement this method
end;

procedure TAHMTextEntryParser.CursorDown;
begin
  // Descendant classes will implement this method
end;

procedure TAHMTextEntryParser.CursorHome;
begin
  FCursorPos := 0;
  FFlashOn := True;
end;

procedure TAHMTextEntryParser.CursorEnd;
begin
  FCursorPos := Length(FText);
  FFlashOn := True;
end;

procedure TAHMTextEntryParser.ScrollUp;
begin
  // Descendant classes will implement this method
end;

procedure TAHMTextEntryParser.ScrollDown;
begin
  // Descendant classes will implement this method
end;

procedure TAHMTextEntryParser.Enter;
begin
  // Descendant classes will implement this method
end;

procedure TAHMTextEntryParser.CommandComplete;
begin
  // Descendant classes will implement this method
end;

function TAHMTextEntryParser.ProcessKeyPress(Key: Word; Shift: TShiftState): Boolean;
begin
  // Set default result - unhandled keypress
  Result := False;

  case Key of
    VK_BACK: Backspace;
    VK_DELETE: DeleteChar;
    VK_LEFT: CursorLeft;
    VK_RIGHT: CursorRight;
    VK_UP: CursorUp;
    VK_DOWN: CursorDown;
    VK_HOME: CursorHome;
    VK_END: CursorEnd;
    VK_PRIOR: ScrollUp;
    VK_NEXT: ScrollDown;
    VK_RETURN: Enter;
    VK_TAB: CommandComplete;
    VK_SPACE: InsertChar(VK_SPACE);
    48: if ssShift in Shift then InsertChar(41) else InsertChar(48); // 0
    49..53: if ssShift in Shift then InsertChar(Key - 16) else InsertChar(Key); // 1..5
    54: if ssShift in Shift then InsertChar(94) else InsertChar(54); // 6
    55: if ssShift in Shift then InsertChar(38) else InsertChar(55); // 7
    56: if ssShift in Shift then InsertChar(42) else InsertChar(56); // 8
    57: if ssShift in Shift then InsertChar(40) else InsertChar(57); // 9
    65..90: if ssShift in Shift then InsertChar(Key) else InsertChar(Key + 32); // a..z
    186: if ssShift in Shift then InsertChar(58) else InsertChar(59); // ; :
    187: if ssShift in Shift then InsertChar(43) else InsertChar(61); // = +
    188: if ssShift in Shift then InsertChar(60) else InsertChar(44); // , <
    189: if ssShift in Shift then InsertChar(95) else InsertChar(45); // - _
    190: if ssShift in Shift then InsertChar(62) else InsertChar(46); // . >
    191: if ssShift in Shift then InsertChar(63) else InsertChar(47); // / ?
    192: if ssShift in Shift then InsertChar(64) else InsertChar(39); // ' @
    219: if ssShift in Shift then InsertChar(123) else InsertChar(91); // [ {
    220: if ssShift in Shift then InsertChar(124) else InsertChar(92); // \ |
    221: if ssShift in Shift then InsertChar(125) else InsertChar(93); // ] }
    222: if ssShift in Shift then InsertChar(126) else InsertChar(35); // # ~
    else Exit;
  end;

  // Okay, key handled
  Result := True;
end;

function TAHMTextEntryParser.ProcessKeyPress(Key: String): Boolean;
var
  sKey: String;
begin
  // Set default result - handled keypress
  Result := True;

  // Check for known virtual key names
  sKey := LowerCase(Key);
  if sKey = KEY_VAL_ENTER then Enter
  else if sKey = KEY_VAL_CLEAR then Clear
  else if sKey = KEY_VAL_BACKSPACE then Backspace
  else if sKey = KEY_VAL_DELETE then DeleteChar
  else if sKey = KEY_VAL_LEFT then CursorLeft
  else if sKey = KEY_VAL_RIGHT then CursorRight
  else if sKey = KEY_VAL_UP then CursorUp
  else if sKey = KEY_VAL_DOWN then CursorDown
  else if sKey = KEY_VAL_HOME then CursorHome
  else if sKey = KEY_VAL_END then CursorEnd
  else if sKey = KEY_VAL_PAGEUP then ScrollUp
  else if sKey = KEY_VAL_PAGEDN then ScrollDown
  else if sKey = KEY_VAL_TAB then CommandComplete
  else if sKey = KEY_VAL_SPACE then InsertChar(VK_SPACE)
  else if sKey <> '' then Result := ProcessKeyPress(Ord(Key[1]), [])
  else Result := False;
end;

(*
  { Virtual Keys, Standard Set }
  {$EXTERNALSYM VK_LBUTTON}
  VK_LBUTTON = 1;
  {$EXTERNALSYM VK_RBUTTON}
  VK_RBUTTON = 2;
  {$EXTERNALSYM VK_CANCEL}
  VK_CANCEL = 3;
  {$EXTERNALSYM VK_MBUTTON}
  VK_MBUTTON = 4;  { NOT contiguous with L & RBUTTON }
  {$EXTERNALSYM VK_BACK}
  VK_BACK = 8;
  {$EXTERNALSYM VK_TAB}
  VK_TAB = 9;
  {$EXTERNALSYM VK_CLEAR}
  VK_CLEAR = 12;
  {$EXTERNALSYM VK_RETURN}
  VK_RETURN = 13;
  {$EXTERNALSYM VK_SHIFT}
  VK_SHIFT = $10;
  {$EXTERNALSYM VK_CONTROL}
  VK_CONTROL = 17;
  {$EXTERNALSYM VK_MENU}
  VK_MENU = 18;
  {$EXTERNALSYM VK_PAUSE}
  VK_PAUSE = 19;
  {$EXTERNALSYM VK_CAPITAL}
  VK_CAPITAL = 20;
  {$EXTERNALSYM VK_KANA }
  VK_KANA = 21;
  {$EXTERNALSYM VK_HANGUL }
  VK_HANGUL = 21;
  {$EXTERNALSYM VK_JUNJA }
  VK_JUNJA = 23;
  {$EXTERNALSYM VK_FINAL }
  VK_FINAL = 24;
  {$EXTERNALSYM VK_HANJA }
  VK_HANJA = 25;
  {$EXTERNALSYM VK_KANJI }
  VK_KANJI = 25;
  {$EXTERNALSYM VK_CONVERT }
  VK_CONVERT = 28;
  {$EXTERNALSYM VK_NONCONVERT }
  VK_NONCONVERT = 29;
  {$EXTERNALSYM VK_ACCEPT }
  VK_ACCEPT = 30;
  {$EXTERNALSYM VK_MODECHANGE }
  VK_MODECHANGE = 31;
  {$EXTERNALSYM VK_ESCAPE}
  VK_ESCAPE = 27;
  {$EXTERNALSYM VK_SPACE}
  VK_SPACE = $20;
  {$EXTERNALSYM VK_PRIOR}
  VK_PRIOR = 33;
  {$EXTERNALSYM VK_NEXT}
  VK_NEXT = 34;
  {$EXTERNALSYM VK_END}
  VK_END = 35;
  {$EXTERNALSYM VK_HOME}
  VK_HOME = 36;
  {$EXTERNALSYM VK_LEFT}
  VK_LEFT = 37;
  {$EXTERNALSYM VK_UP}
  VK_UP = 38;
  {$EXTERNALSYM VK_RIGHT}
  VK_RIGHT = 39;
  {$EXTERNALSYM VK_DOWN}
  VK_DOWN = 40;
  {$EXTERNALSYM VK_SELECT}
  VK_SELECT = 41;
  {$EXTERNALSYM VK_PRINT}
  VK_PRINT = 42;
  {$EXTERNALSYM VK_EXECUTE}
  VK_EXECUTE = 43;
  {$EXTERNALSYM VK_SNAPSHOT}
  VK_SNAPSHOT = 44;
  {$EXTERNALSYM VK_INSERT}
  VK_INSERT = 45;
  {$EXTERNALSYM VK_DELETE}
  VK_DELETE = 46;
  {$EXTERNALSYM VK_HELP}
  VK_HELP = 47;
{ VK_0 thru VK_9 are the same as ASCII '0' thru '9' ($30 - $39) }
{ VK_A thru VK_Z are the same as ASCII 'A' thru 'Z' ($41 - $5A) }
  {$EXTERNALSYM VK_LWIN}
  VK_LWIN = 91;
  {$EXTERNALSYM VK_RWIN}
  VK_RWIN = 92;
  {$EXTERNALSYM VK_APPS}
  VK_APPS = 93;
  {$EXTERNALSYM VK_NUMPAD0}
  VK_NUMPAD0 = 96;
  {$EXTERNALSYM VK_NUMPAD1}
  VK_NUMPAD1 = 97;
  {$EXTERNALSYM VK_NUMPAD2}
  VK_NUMPAD2 = 98;
  {$EXTERNALSYM VK_NUMPAD3}
  VK_NUMPAD3 = 99;
  {$EXTERNALSYM VK_NUMPAD4}
  VK_NUMPAD4 = 100;
  {$EXTERNALSYM VK_NUMPAD5}
  VK_NUMPAD5 = 101;
  {$EXTERNALSYM VK_NUMPAD6}
  VK_NUMPAD6 = 102;
  {$EXTERNALSYM VK_NUMPAD7}
  VK_NUMPAD7 = 103;
  {$EXTERNALSYM VK_NUMPAD8}
  VK_NUMPAD8 = 104;
  {$EXTERNALSYM VK_NUMPAD9}
  VK_NUMPAD9 = 105;
  {$EXTERNALSYM VK_MULTIPLY}
  VK_MULTIPLY = 106;
  {$EXTERNALSYM VK_ADD}
  VK_ADD = 107;
  {$EXTERNALSYM VK_SEPARATOR}
  VK_SEPARATOR = 108;
  {$EXTERNALSYM VK_SUBTRACT}
  VK_SUBTRACT = 109;
  {$EXTERNALSYM VK_DECIMAL}
  VK_DECIMAL = 110;
  {$EXTERNALSYM VK_DIVIDE}
  VK_DIVIDE = 111;
  {$EXTERNALSYM VK_F1}
  VK_F1 = 112;
  {$EXTERNALSYM VK_F2}
  VK_F2 = 113;
  {$EXTERNALSYM VK_F3}
  VK_F3 = 114;
  {$EXTERNALSYM VK_F4}
  VK_F4 = 115;
  {$EXTERNALSYM VK_F5}
  VK_F5 = 116;
  {$EXTERNALSYM VK_F6}
  VK_F6 = 117;
  {$EXTERNALSYM VK_F7}
  VK_F7 = 118;
  {$EXTERNALSYM VK_F8}
  VK_F8 = 119;
  {$EXTERNALSYM VK_F9}
  VK_F9 = 120;
  {$EXTERNALSYM VK_F10}
  VK_F10 = 121;
  {$EXTERNALSYM VK_F11}
  VK_F11 = 122;
  {$EXTERNALSYM VK_F12}
  VK_F12 = 123;
  {$EXTERNALSYM VK_F13}
  VK_F13 = 124;
  {$EXTERNALSYM VK_F14}
  VK_F14 = 125;
  {$EXTERNALSYM VK_F15}
  VK_F15 = 126;
  {$EXTERNALSYM VK_F16}
  VK_F16 = 127;
  {$EXTERNALSYM VK_F17}
  VK_F17 = 128;
  {$EXTERNALSYM VK_F18}
  VK_F18 = 129;
  {$EXTERNALSYM VK_F19}
  VK_F19 = 130;
  {$EXTERNALSYM VK_F20}
  VK_F20 = 131;
  {$EXTERNALSYM VK_F21}
  VK_F21 = 132;
  {$EXTERNALSYM VK_F22}
  VK_F22 = 133;
  {$EXTERNALSYM VK_F23}
  VK_F23 = 134;
  {$EXTERNALSYM VK_F24}
  VK_F24 = 135;
  {$EXTERNALSYM VK_NUMLOCK}
  VK_NUMLOCK = 144;
  {$EXTERNALSYM VK_SCROLL}
  VK_SCROLL = 145;
{ VK_L & VK_R - left and right Alt, Ctrl and Shift virtual keys.
  Used only as parameters to GetAsyncKeyState() and GetKeyState().
  No other API or message will distinguish left and right keys in this way. }
  {$EXTERNALSYM VK_LSHIFT}
  VK_LSHIFT = 160;
  {$EXTERNALSYM VK_RSHIFT}
  VK_RSHIFT = 161;
  {$EXTERNALSYM VK_LCONTROL}
  VK_LCONTROL = 162;
  {$EXTERNALSYM VK_RCONTROL}
  VK_RCONTROL = 163;
  {$EXTERNALSYM VK_LMENU}
  VK_LMENU = 164;
  {$EXTERNALSYM VK_RMENU}
  VK_RMENU = 165;
  {$EXTERNALSYM VK_PROCESSKEY}
  VK_PROCESSKEY = 229;
  {$EXTERNALSYM VK_ATTN}
  VK_ATTN = 246;
  {$EXTERNALSYM VK_CRSEL}
  VK_CRSEL = 247;
  {$EXTERNALSYM VK_EXSEL}
  VK_EXSEL = 248;
  {$EXTERNALSYM VK_EREOF}
  VK_EREOF = 249;
  {$EXTERNALSYM VK_PLAY}
  VK_PLAY = 250;
  {$EXTERNALSYM VK_ZOOM}
  VK_ZOOM = 251;
  {$EXTERNALSYM VK_NONAME}
  VK_NONAME = 252;
  {$EXTERNALSYM VK_PA1}
  VK_PA1 = 253;
  {$EXTERNALSYM VK_OEM_CLEAR}
  VK_OEM_CLEAR = 254;
*)


end.
